perm filename INDAT4.SAI[X,ALS]3 blob
sn#088674 filedate 1974-02-25 generic text, type T, neo UTF8
00010 ENTRY PREPARE;
00020 BEGIN
00030 DEFINE ⊂="COMMENT",CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00040 DEFINE ⊃="⊂"; ⊂ Used to delete output statements for PLOT;
00050 DEFINE $=" "; ⊂ Used to delete outstr's;
00060 DEFINE Z="10000%256";
00070 EXTERNAL REAL ARRAY A,C,D[0:512];
00080 ⊃ INTERNAL INTEGER ARRAY NEW[0:512];
00090 INTERNAL INTEGER ARRAY INNAME,INDATA[0:32];
00100 EXTERNAL INTEGER ARRAY FVAL[0:8];
00110 INTEGER I,J,K,P,POINTP,NX;
00120 ⊃ EXTERNAL INTEGER CHAN5;
00130 INTERNAL INTEGER INFLAG;
00140 INTEGER F1_LOW,F1_HI,F2_LOW,F2_HI,F3_LOW,F3_HI,F4_LOW,F4_HI,F5_LOW;
00150 INTEGER F5_HI,NP_LOW,NP_HI,NZ_LOW,NZ_HI,FP1_LO,FP1_H,FP2_LO,FP2_H;
00160 INTERNAL INTEGER F1,F2,F3,F4,F5,NP,NZ,FP1,FP2,A1,A2,A3,A4,A5;
00170 INTEGER FA,FB,FC,FD,FE;
00180 INTEGER M1,M2,M3,M4,M5;
00190
00200
00210
00220
00230 INTERNAL PROCEDURE DEFINES;
00240 BEGIN
00250 F1_LOW← 180 * 256%10000; F1_HI← 850 * 256%10000;
00260 F2_LOW← 700 * 256%10000; F2_HI← 2500 * 256%10000;
00270 F3_LOW← 1570 * 256%10000; F3_HI← 3400 * 256%10000;
00280 F4_LOW← 2500 * 256%10000; F4_HI← 4500 * 256%10000;
00290 F5_LOW← 3600 * 256%10000; F5_HI← 5400 * 256%10000;
00300
00310 M1← 320 * 256%10000;
00320 M2← 1350 * 256%10000;
00330 M3← 2800 * 256%10000;
00340 M4← 3400 * 256%10000;
00350 M5← 4500 * 256%10000;
00360
00370 FP1_LO← 1800 * 256%10000; FP1_H← 3200 * 256%10000;
00380 FP2_LO← 3200 * 256%10000; FP2_H← 5000 * 256%10000;
00390
00400
00410 NP_LOW← 800 * 256%10000; NP_HI← 1500 * 256%10000;
00420 NZ_LOW←NP-500* 256%10000; NZ_HI←NP+500* 256%10000;
00430 END;
00440
00450 INTERNAL PROCEDURE DATOUT;
00460 BEGIN
00470
00480 ⊃ ARRYOUT(CHAN5,NEW[0],512);
00490 ⊃ POINTP←POINT(9,NEW[1],-1);
00500 NX←0;
00510 END;
00520
00530
00540
00010 INTEGER PROCEDURE PEAK (INTEGER LOW,HIGH);
00020 BEGIN
00030 INTEGER I,J,K; REAL MAX,MIN;
00040
00050 MAX←-10000; K←LOW;
00060
00070 FOR I←LOW STEP 1 UNTIL HIGH DO
00080 IF C[I]>MAX THEN BEGIN MAX←C[I]; J←I; END;
00090
00100 IF J=LOW THEN BEGIN
00110 MAX←-10000; MIN←10000;
00120 FOR I←LOW STEP 1 UNTIL HIGH DO BEGIN
00130 IF C[I]>MIN THEN DONE;
00140 IF C[I]<MIN THEN BEGIN MIN←C[I]; K←I; END;
00150 END;
00160
00170 FOR I←K STEP 1 UNTIL HIGH DO
00180 IF C[I]>MAX THEN BEGIN MAX←C[I]; J←I; END;
00190 END;
00200
00210 IF J=HIGH THEN BEGIN
00220 MAX←-10000; MIN←10000;
00230 FOR I←HIGH STEP -1 UNTIL K DO BEGIN
00240 IF C[I]>MIN THEN DONE;
00250 IF C[I]<MIN THEN MIN←C[I];
00260 END;
00270
00280 FOR I←I STEP -1 UNTIL K DO
00290 IF C[I]>MAX THEN BEGIN MAX←C[I]; J←I; END;
00300 END;
00310
00320 IF J=LOW THEN J←0; ⊂ No proper peak found;
00330
00340 RETURN(J);
00350 END;
00360
00370 INTEGER PROCEDURE BAND(INTEGER F);
00380 BEGIN
00390 INTEGER I,J;
00400
00410 FOR I←F STEP 1 UNTIL 255 DO IF (C[I]+6)≤C[F] THEN DONE;
00420 ⊂ OUTSTR("F="&CVS(F)&TB&"I="&CVS(I)&TB);
00430
00440 FOR J←F STEP -1 UNTIL 0 DO IF (C[J]+6)≤C[F] THEN DONE;
00450 ⊂ OUTSTR("J="&CVS(J)&CRLF);
00460 IF (F-J)<(I-F) THEN RETURN(F-J) ELSE RETURN(I-F);
00470 END;
00480
00490 INTEGER PROCEDURE REMOVE(INTEGER F,LIMIT);
00500 BEGIN
00510 INTEGER I,J,K;
00520 REAL X,Y,MAX,MIN;
00530
00540 FOR I←F STEP 1 UNTIL LIMIT DO IF C[I]≤C[F]-6 THEN BEGIN J←I; DONE; END;
00550 FOR I←F STEP -1 UNTIL 0 DO IF C[I]≤C[F]-6 THEN BEGIN K←I; DONE; END;
00560 IF ABS(F-K)<ABS(J-F) THEN I←ABS(F-K) ELSE I←ABS(J-F);
00570 X←6.0; X←X/(I*I);
00580 MAX←-10000;
00590 ⊂ OUTSTR("I="&CVS(I)&" ");
00600
00610 FOR I←I+F STEP 1 UNTIL LIMIT DO
00620 IF (Y←(C[I]-C[F]+X*(I-F)*(I-F)))>MAX THEN BEGIN MAX←Y; J←I; END;
00630 IF J=LIMIT THEN J←0;
00640
00650 RETURN(J);
00660 END;
00670
00010 PROCEDURE FORMANT;
00020 BEGIN
00030
00040 REAL X,Y;
00050
00060 IF INFLAG=0 THEN BEGIN
00070 ⊃ POINTP←POINT(9,NEW[1],-1); NX←0;
00080
00090 INNAME[P]←CVASC("F1"); P←P+1;
00100 INNAME[P]←CVASC("F2"); P←P+1;
00110 INNAME[P]←CVASC("F3"); P←P+1;
00120 INNAME[P]←CVASC("F4"); P←P+1;
00130 INNAME[P]←CVASC("F5"); P←P+1;
00140
00150 INNAME[P]←CVASC("A1"); P←P+1;
00160 INNAME[P]←CVASC("A2"); P←P+1;
00170 INNAME[P]←CVASC("A3"); P←P+1;
00180 INNAME[P]←CVASC("A4"); P←P+1;
00190 INNAME[P]←CVASC("A5"); P←P+1;
00200
00210 INNAME[P]←CVASC("B1"); P←P+1;
00220 INNAME[P]←CVASC("B2"); P←P+1;
00230 INNAME[P]←CVASC("B3"); P←P+1;
00240 INNAME[P]←CVASC("B4"); P←P+1;
00250 INNAME[P]←CVASC("B5"); P←P+1;
00260
00270 END ELSE BEGIN
00280 $ OUTSTR(CRLF&"⊗ ");
00290
00300 FA←PEAK(0,M1);
00310 F1←PEAK(F1_LOW,F1_HI);
00320 F2←PEAK(F2_LOW,F2_HI);
00330 IF (C[FA]>C[F1])∧(F1=F2) THEN BEGIN
00340 FB←REMOVE(FA,F1); $ OUTSTR("Voice bar,");
00350 IF C[FB]>C[F1] THEN BEGIN
00360 $ OUTSTR("Remove,old F1="&CVS(F1*Z)&",New="&CVS(FA*Z)&TB);
00370 F1←FA; END;
00380 END;
00390 IF (F1+3>INDATA[P])∧(F1+4<F2_LOW) THEN F2←PEAK(F2_LOW,F2_HI)
00400 ELSE BEGIN
00410 IF INDATA[P]>F2_LOW THEN F2←PEAK(INDATA[P]+1,F2_HI)
00420 ELSE F2←PEAK(F2_LOW,F2_HI); END;
00430
00440 F3←PEAK(F3_LOW,F3_HI);
00450 F4←PEAK(F4_LOW,F4_HI);
00460 F5←PEAK(F5_LOW,F5_HI);
00470
00480 IF F1=F2 THEN BEGIN
00490 $ OUTSTR("F1=F2="&CVS(F1*10000%256));
00500 FA←PEAK(F1_LOW,F1);
00510 IF FA=0 THEN X←0 ELSE X←C[FA];
00520 FB←PEAK(F2,F2_HI);
00530 IF FB=0 THEN Y←0 ELSE Y←C[FB];
00540 IF (X>Y)∧((X+6)>C[F1]) THEN F1←FA ELSE F2←FB;
00550 $ OUTSTR("FA="&CVS(FA*Z)&","&CVF(X)&"FB="&CVS(FB*Z)&","&CVF(Y)&TB);
00560 END;
00570
00580 IF F2=0 THEN BEGIN
00590 F2←REMOVE(F1,F2_HI);
00600 $ OUTSTR("REMOVE ");
00610 END;
00620 IF F2<F2_LOW THEN F2←INDATA[P+1];
00630
00640 IF (F2+4) < F3_LOW THEN F3←PEAK(F3_LOW-2,F3_HI)
00650 ELSE F3←PEAK(F3_LOW,F3_HI);
00660
00670 IF F2=F3 THEN BEGIN
00680 $ OUTSTR("F2=F3="&CVS(F3*10000%256));
00690 FC←PEAK(F3,F3_HI);
00700 IF FC=0 THEN Y←0 ELSE Y←C[FC];
00710 IF F1>F2_LOW THEN FB←PEAK(F1,F3) ELSE FB←PEAK(F2_LOW,F3);
00720 IF FB=0 THEN X←0 ELSE X←C[FB];
00730 IF (Y+6>X)∧((Y+24)>C[F3]) THEN F3←FC ELSE F2←FB;
00740 $ OUTSTR("FB="&CVS(FB*Z)&","&CVS(X)&"FC="&CVS(FC*Z)&","&CVF(Y)&TB);
00750 END;
00760
00770 IF ((C[F2]+24)<C[F1])∧(F1>F2_LOW) THEN BEGIN
00780 IF F3>F2_HI THEN FB←REMOVE(F1,F2) ELSE FB←REMOVE(F1,F2_HI);
00790 IF FB←0 THEN X←0 ELSE X←C[FB];
00800 IF X>C[F2] THEN F2←FB;
00810 END;
00820
00830 IF F3=F4 THEN BEGIN
00840 $ OUTSTR("F3=F4="&CVS(F4*10000%256));
00850 FD←PEAK(F4,F4_HI);
00860 IF FD=0 THEN Y←0 ELSE Y←C[FD];
00870 IF F2>F3_LOW THEN FC←PEAK(F2,F4) ELSE FC←PEAK(F3_LOW,F4);
00880 IF FC=0 THEN X←0 ELSE X←C[FC];
00890 IF Y+12≥X THEN F4←FD ELSE F3←FC;
00900 $ OUTSTR("FC="&CVS(FC*Z)&","&CVS(X)&"FD="&CVS(FD*Z)&","&CVF(Y)&TB);
00910 END;
00920
00930 IF F4=F5 THEN BEGIN
00940 $ OUTSTR("F4=F5="&CVS(F5*10000%256));
00950 FE←PEAK(F5,F5_HI);
00960 IF FE=0 THEN Y←0 ELSE Y←C[FE];
00970 IF F3>F4_LOW THEN FD←PEAK(F3,F5) ELSE FD←PEAK(F4_LOW,F5);
00980 IF FD=0 THEN X←0 ELSE X←C[FD];
00990 IF Y+12≥X THEN F5←FE ELSE F4←FD;
01000 $ OUTSTR("FD="&CVS(FD*Z)&","&CVS(X)&"FE="&CVS(FE*Z)&","&CVF(Y)&TB);
01010 END;
01020
01030 $ OUTSTR(CRLF&TB&CVS(F1*Z)&","&CVS(F2*Z)&","&CVS(F3*Z)&","&CVS(F4*Z)
01040 &","&CVS(F5*Z)&TB&CVF(C[F1])&","&CVF(C[F2])&","&CVF(C[F3])&","&
01045 CVF(C[F4])&","&CVS(C[F5])&CRLF);
01050
01060 INDATA[P]←F1; P←P+1;
01070 INDATA[P]←F2; P←P+1;
01080 INDATA[P]←F3; P←P+1;
01090 INDATA[P]←F4; P←P+1;
01100 INDATA[P]←F5; P←P+1;
01110 INDATA[P]←C[F1]; P←P+1;
01120 INDATA[P]←C[F2]; P←P+1;
01130 INDATA[P]←C[F3]; P←P+1;
01140 INDATA[P]←C[F4]; P←P+1;
01150 INDATA[P]←C[F5]; P←P+1;
01160
01170 INDATA[P]←BAND(F1)*10000%256; P←P+1;
01180 INDATA[P]←BAND(F2)*10000%256; P←P+1;
01190 INDATA[P]←BAND(F3)*10000%256; P←P+1;
01200 INDATA[P]←BAND(F4)*10000%256; P←P+1;
01210 INDATA[P]←BAND(F5)*10000%256; P←P+1;
01220 END;
01230 END;
01240
00010 INTERNAL PROCEDURE PREPARE;
00020 BEGIN
00030
00040 P←0;
00050
00060 FORMANT;
00070
00080
00090 ⊃ IF INFLAG≠0 THEN BEGIN
00100 ⊃ NEW[NX]←FVAL[4];
00110 ⊃ FOR I←0 STEP 1 UNTIL 27 DO IDPB(INDATA[I],POINTP);
00120 ⊃ FOR I←1 STEP 1 UNTIL 4 DO IBP(POINTP);
00130 ⊃ NX←NX+8;
00140 ⊃ IF NX≥512 THEN DATOUT;
00150 ⊃ END;
00160
00170 END;
00180
00190 END;
00200